home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Collection of Tools & Utilities
/
Collection of Tools and Utilities.iso
/
archiver
/
ldiff12s.zip
/
KERR.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1989-07-15
|
2KB
|
82 lines
(*$B-,F-,I-,N-*)
(*---------------------------------------------------------------------------*)
(* *)
(* KERR - Err unit for Turbo Pascal 4.0 *)
(* *)
(* Copyright(c) 1988 Jun Katsumata *)
(* *)
(* ver1.00 1988/02/22 *)
(* ver1.01 1988/02/25 append é╔æ╬ë₧é╡é─éóé╚é⌐é┴é╜é▒é╞é≡É[é¡ö╜Å╚ *)
(* ver1.02 1988/05/05 Äßè▒é╠ÄΦÆ╝é╡ by Kazuhiko Miki *)
(*---------------------------------------------------------------------------*)
unit kerr;
interface
uses dos;
procedure assignerr(var f:text);
implementation
const
stderr = 2;
var
regs : registers;
{$f+}
function erroutput(var f:textrec):integer;
begin
with regs,f do begin
ah:=$40;
bx:=stderr;
cx:=bufpos;
ds:=seg(bufptr^);
dx:=ofs(bufptr^);
msdos(regs);
if ax=bufpos
then erroutput:=0
else erroutput:=101; { disk write error }
bufpos:=0;
end;
end;
function erropen(var f:textrec):integer;
begin
with f do begin
if mode=fminput then
erropen:=5
else begin
mode:=fmoutput;
inoutfunc:=@erroutput;
flushfunc:=@erroutput;
closefunc:=@erroutput;
erropen:=0;
end;
end;
end;
{$f-}
procedure assignerr(var f:text);
begin
with textrec(f) do begin
handle :=$ffff;
mode :=fmclosed;
bufsize :=sizeof(buffer);
bufptr :=@buffer;
openfunc:=@erropen;
name[0] :=#0;
end;
end;
end.